home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 2: Applications / Linux Cubed Series 2 - Applications.iso / editors / emacs / xemacs / xemacs-1.004 / xemacs-1 / xemacs-19.13 / src / cmds.c < prev    next >
Encoding:
C/C++ Source or Header  |  1995-08-04  |  12.3 KB  |  448 lines
  1. /* Simple built-in editing commands.
  2.    Copyright (C) 1985, 1992, 1993, 1994 Free Software Foundation, Inc.
  3.  
  4. This file is part of XEmacs.
  5.  
  6. XEmacs is free software; you can redistribute it and/or modify it
  7. under the terms of the GNU General Public License as published by the
  8. Free Software Foundation; either version 2, or (at your option) any
  9. later version.
  10.  
  11. XEmacs is distributed in the hope that it will be useful, but WITHOUT
  12. ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
  13. FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
  14. for more details.
  15.  
  16. You should have received a copy of the GNU General Public License
  17. along with XEmacs; see the file COPYING.  If not, write to the Free
  18. Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.  */
  19.  
  20. /* Synched up with: Mule 2.0, FSF 19.28. */
  21.  
  22. #include <config.h>
  23. #include "lisp.h"
  24. #include "commands.h"
  25. #include "buffer.h"
  26. #include "syntax.h"
  27. #include "insdel.h"
  28.  
  29. Lisp_Object Qkill_forward_chars;
  30. Lisp_Object Qself_insert_command;
  31.  
  32. Lisp_Object Vblink_paren_function;
  33.  
  34. /* A possible value for a buffer's overwrite-mode variable.  */
  35. Lisp_Object Qoverwrite_mode_binary;
  36.  
  37.  
  38. DEFUN ("forward-char", Fforward_char, Sforward_char, 0, 2, "_p",
  39.   "Move point right ARG characters (left if ARG negative).\n\
  40. On reaching end of buffer, stop and signal error.\n\
  41. If BUFFER is nil, the current buffer is assumed.")
  42.   (arg, buffer)
  43.      Lisp_Object arg, buffer;
  44. {
  45.   struct buffer *buf = decode_buffer (buffer, 1);
  46.  
  47.   if (NILP (arg))
  48.     arg = make_number (1);
  49.   else
  50.     CHECK_INT (arg, 0);
  51.  
  52.   /* This used to just set point to point + XINT (arg), and then check
  53.      to see if it was within boundaries.  But now that SET_PT can
  54.      potentially do a lot of stuff (calling entering and exiting
  55.      hooks, etcetera), that's not a good approach.  So we validate the
  56.      proposed position, then set point.  */
  57.   {
  58.     Bufpos new_point = BUF_PT (buf) + XINT (arg);
  59.  
  60.     if (new_point < BUF_BEGV (buf))
  61.       {
  62.     BUF_SET_PT (buf, BUF_BEGV (buf));
  63.     Fsignal (Qbeginning_of_buffer, Qnil);
  64.       }
  65.     if (new_point > BUF_ZV (buf))
  66.       {
  67.     BUF_SET_PT (buf, BUF_ZV (buf));
  68.     Fsignal (Qend_of_buffer, Qnil);
  69.       }
  70.  
  71.     BUF_SET_PT (buf, new_point);
  72.   }
  73.  
  74.   return Qnil;
  75. }
  76.  
  77. DEFUN ("backward-char", Fbackward_char, Sbackward_char, 0, 2, "_p",
  78.   "Move point left ARG characters (right if ARG negative).\n\
  79. On attempt to pass beginning or end of buffer, stop and signal error.\n\
  80. If BUFFER is nil, the current buffer is assumed.")
  81.   (arg, buffer)
  82.      Lisp_Object arg, buffer;
  83. {
  84.   if (NILP (arg))
  85.     arg = make_number (1);
  86.   else
  87.     CHECK_INT (arg, 0);
  88.  
  89.   XSETINT (arg, - XINT (arg));
  90.   return Fforward_char (arg, buffer);
  91. }
  92.  
  93. DEFUN ("forward-line", Fforward_line, Sforward_line, 0, 2, "_p",
  94.   "Move ARG lines forward (backward if ARG is negative).\n\
  95. Precisely, if point is on line I, move to the start of line I + ARG.\n\
  96. If there isn't room, go as far as possible (no error).\n\
  97. Returns the count of lines left to move.  If moving forward,\n\
  98. that is ARG - number of lines moved; if backward, ARG + number moved.\n\
  99. With positive ARG, a non-empty line at the end counts as one line\n\
  100.   successfully moved (for the return value).\n\
  101. If BUFFER is nil, the current buffer is assumed.")
  102.   (arg, buffer)
  103.      Lisp_Object arg, buffer;
  104. {
  105.   struct buffer *buf = decode_buffer (buffer, 1);
  106.   Bufpos pos2 = BUF_PT (buf);
  107.   Bufpos pos;
  108.   int count, shortage, negp;
  109.  
  110.   if (NILP (arg))
  111.     count = 1;
  112.   else
  113.     {
  114.       CHECK_INT (arg, 0);
  115.       count = XINT (arg);
  116.     }
  117.  
  118.   negp = count <= 0;
  119.   pos = scan_buffer (buf, '\n', pos2, 0, count - negp, &shortage, 1);
  120.   if (shortage > 0
  121.       && (negp
  122.       || (BUF_ZV (buf) > BUF_BEGV (buf)
  123.           && pos != pos2
  124.           && BUF_FETCH_CHAR (buf, pos - 1) != '\n')))
  125.     shortage--;
  126.   BUF_SET_PT (buf, pos);
  127.   return make_number (negp ? - shortage : shortage);
  128. }
  129.  
  130. DEFUN ("beginning-of-line", Fbeginning_of_line, Sbeginning_of_line,
  131.   0, 2, "_p",
  132.   "Move point to beginning of current line.\n\
  133. With argument ARG not nil or 1, move forward ARG - 1 lines first.\n\
  134. If scan reaches end of buffer, stop there without error.\n\
  135. If BUFFER is nil, the current buffer is assumed.")
  136.   (arg, buffer)
  137.      Lisp_Object arg, buffer;
  138. {
  139.   struct buffer *b = decode_buffer (buffer, 1);
  140.  
  141.   XSETBUFFER (buffer, b);
  142.   if (NILP (arg))
  143.     arg = make_number (1);
  144.   else
  145.     CHECK_INT (arg, 0);
  146.  
  147.   Fforward_line (make_number (XINT (arg) - 1), buffer);
  148.   return Qnil;
  149. }
  150.  
  151. DEFUN ("end-of-line", Fend_of_line, Send_of_line,
  152.   0, 2, "_p",
  153.   "Move point to end of current line.\n\
  154. With argument ARG not nil or 1, move forward ARG - 1 lines first.\n\
  155. If scan reaches end of buffer, stop there without error.\n\
  156. If BUFFER is nil, the current buffer is assumed.")
  157.   (arg, buffer)
  158.      Lisp_Object arg, buffer;
  159. {
  160.   REGISTER Bufpos pos;
  161.   REGISTER Bufpos stop;
  162.   struct buffer *buf = decode_buffer (buffer, 1);
  163.  
  164.   XSETBUFFER (buffer, buf);
  165.  
  166.   if (NILP (arg))
  167.     arg = make_number (1);
  168.   else
  169.     CHECK_INT (arg, 0);
  170.  
  171.   if (XINT (arg) != 1)
  172.     Fforward_line (make_number (XINT (arg) - 1), buffer);
  173.  
  174.   pos = BUF_PT (buf);
  175.   stop = BUF_ZV (buf);
  176.   while (pos < stop && BUF_FETCH_CHAR (buf, pos) != '\n') pos++;
  177.   BUF_SET_PT (buf, pos);
  178.   return Qnil;
  179. }
  180.  
  181. DEFUN ("delete-char", Fdelete_char, Sdelete_char, 1, 2, "*p\nP",
  182.   "Delete the following ARG characters (previous, with negative arg).\n\
  183. Optional second arg KILLFLAG non-nil means kill instead (save in kill ring).\n\
  184. Interactively, ARG is the prefix arg, and KILLFLAG is set if\n\
  185. ARG was explicitly specified.")
  186.   (arg, killflag)
  187.      Lisp_Object arg, killflag;
  188. {
  189.   /* This function can GC */
  190.   Bufpos pos;
  191.   struct buffer *buf = current_buffer;
  192.  
  193.   CHECK_INT (arg, 0);
  194.  
  195.   pos = BUF_PT (buf) + XINT (arg);
  196.   if (NILP (killflag))
  197.     {
  198.       if (XINT (arg) < 0)
  199.     {
  200.       if (pos < BUF_BEGV (buf))
  201.         signal_error (Qbeginning_of_buffer, Qnil);
  202.       else
  203.         buffer_delete_range (buf, pos, BUF_PT (buf), 0);
  204.     }
  205.       else
  206.     {
  207.       if (pos > BUF_ZV (buf))
  208.         signal_error (Qend_of_buffer, Qnil);
  209.       else
  210.         buffer_delete_range (buf, BUF_PT (buf), pos, 0);
  211.     }
  212.     }
  213.   else
  214.     {
  215.       call1 (Qkill_forward_chars, arg);
  216.     }
  217.   return Qnil;
  218. }
  219.  
  220. DEFUN ("delete-backward-char", Fdelete_backward_char, Sdelete_backward_char,
  221.   1, 2, "*p\nP",
  222.   "Delete the previous ARG characters (following, with negative ARG).\n\
  223. Optional second arg KILLFLAG non-nil means kill instead (save in kill ring).\n\
  224. Interactively, ARG is the prefix arg, and KILLFLAG is set if\n\
  225. ARG was explicitly specified.")
  226.   (arg, killflag)
  227.      Lisp_Object arg, killflag;
  228. {
  229.   /* This function can GC */
  230.   CHECK_INT (arg, 0);
  231.   return Fdelete_char (make_number (-XINT (arg)), killflag);
  232. }
  233.  
  234. static void internal_self_insert (Emchar ch, int noautofill);
  235.  
  236. DEFUN ("self-insert-command", Fself_insert_command, Sself_insert_command, 1, 1, "*p",
  237.   "Insert the character you type.\n\
  238. Whichever character you type to run this command is inserted.")
  239.   (arg)
  240.      Lisp_Object arg;
  241. {
  242.   /* This function can GC */
  243.   int n;
  244.   Emchar ch;
  245.   Lisp_Object c;
  246.   CHECK_INT (arg, 0);
  247.  
  248.   if (INTP (Vlast_command_char))
  249.     c = Vlast_command_char;
  250.   else
  251.     c = Fevent_to_character (Vlast_command_event, Qnil, Qnil, Qt);
  252.  
  253.   if (NILP (c))
  254.     signal_simple_error ("last typed character has no ASCII equivalent",
  255.                          Fcopy_event (Vlast_command_event, Qnil));
  256.  
  257.   CHECK_COERCE_CHAR (c, 0);
  258.  
  259.   n = XINT (arg);
  260.   ch = XINT (c);
  261.   while (n > 0)
  262.     {
  263.       n--;
  264.       internal_self_insert (ch, (n != 0));
  265.     }
  266.   return Qnil;
  267. }
  268.  
  269. DEFUN ("newline", Fnewline, Snewline, 0, 1, "*P",
  270.   "Insert a newline.  With arg, insert that many newlines.\n\
  271. In Auto Fill mode, if no numeric arg, break the preceding line if it's long.")
  272.   (arg1)
  273.      Lisp_Object arg1;
  274. {
  275.   /* This function can GC */
  276.   int flag;
  277.   int arg;
  278.   char c1 = '\n';
  279.   struct buffer *buf = current_buffer;
  280.  
  281.   arg = XINT (Fprefix_numeric_value (arg1));
  282.  
  283.   /* !!#### review this function. */
  284.  
  285.   barf_if_buffer_read_only (buf, BUF_PT (buf), -1);
  286.  
  287.   /* Inserting a newline at the end of a line produces better
  288.      redisplay in try_window_id than inserting at the beginning of a
  289.      line, and the textual result is the same.  So, if we're at
  290.      beginning of line, pretend to be at the end of the previous line.  
  291.  
  292.      We can't use internal_self_insert in that case since it won't do
  293.      the insertion correctly.  Luckily, internal_self_insert's special
  294.      features all do nothing in that case.  */
  295.  
  296.   flag = BUF_PT (buf) > BUF_BEGV (buf) &&
  297.     BUF_FETCH_CHAR (buf, BUF_PT (buf) - 1) == '\n';
  298.   if (flag)
  299.     BUF_SET_PT (buf, BUF_PT (buf) - 1);
  300.  
  301.   while (arg > 0)
  302.     {
  303.       if (flag)
  304.     buffer_insert_c_char (current_buffer, c1);
  305.       else
  306.     internal_self_insert ('\n', !NILP (arg1));
  307.       arg--;
  308.     }
  309.  
  310.   if (flag)
  311.     BUF_SET_PT (buf, BUF_PT (buf) + 1);
  312.  
  313.   return Qnil;
  314. }
  315.  
  316. /* Insert character C1.  If NOAUTOFILL is nonzero, don't do autofill
  317.    even if it is enabled.
  318.  
  319.    FSF:
  320.  
  321.    If this insertion is suitable for direct output (completely simple),
  322.    return 0.  A value of 1 indicates this *might* not have been simple.
  323.    A value of 2 means this did things that call for an undo boundary.  */
  324.  
  325. static void
  326. internal_self_insert (Emchar c1, int noautofill)
  327. {
  328.   /* This function can GC */
  329.   /* int hairy = 0; -- unused */
  330.   REGISTER enum syntaxcode synt;
  331.   REGISTER Emchar c2;
  332.   Lisp_Object overwrite;
  333.   Lisp_Object syntax_table;
  334.   struct buffer *buf = current_buffer;
  335.   
  336.   overwrite = buf->overwrite_mode;
  337.   syntax_table = buf->syntax_table;
  338.  
  339. #if 0
  340.   /* No, this is very bad, it makes undo *always* undo a character at a time
  341.      instead of grouping consecutive self-inserts together.  Nasty nasty.
  342.    */
  343.   if (!NILP (Vbefore_change_functions) || !NILP (Vafter_change_functions)
  344.       || !NILP (Vbefore_change_function) || !NILP (Vafter_change_function))
  345.     hairy = 1;
  346. #endif
  347.  
  348.   if (!NILP (overwrite)
  349.       && BUF_PT (buf) < BUF_ZV (buf)
  350.       && (EQ (overwrite, Qoverwrite_mode_binary)
  351.       || (c1 != '\n' && BUF_FETCH_CHAR (buf, BUF_PT (buf)) != '\n'))
  352.       && (EQ (overwrite, Qoverwrite_mode_binary)
  353.           || BUF_FETCH_CHAR (buf, BUF_PT (buf)) != '\t'
  354.       || XINT (buf->tab_width) <= 0
  355.       || XINT (buf->tab_width) > 20
  356.       || !((current_column (buf) + 1) % XINT (buf->tab_width))))
  357.     {
  358.       buffer_delete_range (buf, BUF_PT (buf), BUF_PT (buf) + 1, 0);
  359.       /* hairy = 1; */
  360.     }
  361.  
  362.   if (!NILP (buf->abbrev_mode)
  363.       && SYNTAX (syntax_table, c1) != Sword
  364.       && NILP (buf->read_only)
  365.       && BUF_PT (buf) > BUF_BEGV (buf))
  366.     {
  367.       c2 = BUF_FETCH_CHAR (buf, BUF_PT (buf) - 1);
  368.  
  369.       if (SYNTAX (syntax_table, c2) == Sword)
  370.     {
  371.       /* int modiff = BUF_MODIFF (current_buffer); */
  372.       Fexpand_abbrev ();
  373.       /* We can't trust the value of Fexpand_abbrev,
  374.          but if Fexpand_abbrev changed the buffer,
  375.          assume it expanded something.  */
  376.       /* if (BUF_MODIFF (buf) != modiff)
  377.          hairy = 2; */
  378.         }
  379.     }
  380.   if ((c1 == ' ' || c1 == '\n')
  381.       && !noautofill
  382.       && !NILP (buf->auto_fill_function)
  383.       && current_column (buf) > XINT (buf->fill_column))
  384.     {
  385.       if (c1 != '\n')
  386.     buffer_insert_emacs_char (buf, c1);
  387.       call0 (buf->auto_fill_function);
  388.       if (c1 == '\n')
  389.     buffer_insert_emacs_char (buf, c1);
  390.       /* hairy = 1; */
  391.     }
  392.   else
  393.     buffer_insert_emacs_char (buf, c1);
  394.   synt = SYNTAX (syntax_table, c1);
  395.   if ((synt == Sclose || synt == Smath)
  396.       && !NILP (Vblink_paren_function) && INTERACTIVE)
  397.     {
  398.       call0 (Vblink_paren_function);
  399.       /* hairy = 2; */
  400.     }
  401. }
  402.  
  403. /* (this comes from Mule but is a generally good idea) */
  404.  
  405. DEFUN ("self-insert-internal", Fself_insert_internal, Sself_insert_internal,
  406.        1, 1, 0,
  407.   "Invoke `self-insert-command' as if CH is entered from keyboard.")
  408.   (ch)
  409.      Lisp_Object ch;
  410. {
  411.   /* This function can GC */
  412.   CHECK_COERCE_CHAR (ch, 0);
  413.   internal_self_insert (XINT (ch), 0);
  414.   return Qnil;
  415. }
  416.  
  417. /* module initialization */
  418.  
  419. void
  420. syms_of_cmds (void)
  421. {
  422.   defsymbol (&Qkill_forward_chars, "kill-forward-chars");
  423.   defsymbol (&Qself_insert_command, "self-insert-command");
  424.   defsymbol (&Qoverwrite_mode_binary, "overwrite-mode-binary");
  425.  
  426.   defsubr (&Sforward_char);
  427.   defsubr (&Sbackward_char);
  428.   defsubr (&Sforward_line);
  429.   defsubr (&Sbeginning_of_line);
  430.   defsubr (&Send_of_line);
  431.  
  432.   defsubr (&Sdelete_char);
  433.   defsubr (&Sdelete_backward_char);
  434.  
  435.   defsubr (&Sself_insert_command);
  436.   defsubr (&Sself_insert_internal);
  437.   defsubr (&Snewline);
  438. }
  439.  
  440. void
  441. vars_of_cmds (void)
  442. {
  443.   DEFVAR_LISP ("blink-paren-function", &Vblink_paren_function,
  444.     "Function called, if non-nil, whenever a close parenthesis is inserted.\n\
  445. More precisely, a char with closeparen syntax is self-inserted.");
  446.   Vblink_paren_function = Qnil;
  447. }
  448.